(*
 *
 *)

type ht = HTConst of const 
        | HTVar 
        | HTNB (* not bound *);;


exception OpNotValid of string;;
exception ChNotInNew of string;;
exception IfCond of string;;
exception IOFail of string;;
exception NP;;


(* p e' un processo in AST *)
class mk_state p =


  object (s)
    val heap = MyHeap.createh()
    val run = MyQueue.createq()
    val mutable cvar = 0

    method flush strl =
         let rec aux l acc = 
            match l with
               []    -> acc
            |  x::[] -> acc^x (* per non inserire virgola a fine lista*)
            |  x::y  -> aux y (acc^x^",")
          in print_string ("PRINT ===> <"^(aux strl "")^">")
   
    
            
    method cvarinc = 
        cvar <- cvar + 1; 
        "#"^(string_of_int cvar) 


   method op2val op =
           match op with
               Op("+", Const(Int(e1)), Const(Int(e2)))
                 -> Int(e1+e2)
           |  Op("-", Const(Int(e1)), Const(Int(e2)))
                 -> Int(e1-e2)
           |  Op("*", Const(Int(e1)), Const(Int(e2)))
                 -> Int(e1*e2)      
           |  Op("=", Const(Int(e1)), Const(Int(e2)))
                 -> Bool(e1 = e2)      
           |  Op("and", Const(Bool(e1)), Const(Bool(e2)))
                 -> Bool( e1 && e2) 
           | _ -> raise (OpNotValid ("errore tipo bool int op"))
               
                 

   method exp2val env e =
           match e with 
             Const(c) -> c
           
           | Var(var) -> if MyEnv.isindom var env
                            then match MyEnv.valinenv var env with
                                   HTConst(c) -> c
                                 | _ -> raise (OpNotValid ("attesa constante"))
                            else  raise (OpNotValid ("var non instanziata"))
             
           | Op(op, e1, e2)
              -> let c1 = s#exp2val env e1
                 in let c2 = s#exp2val env e2
                    in s#op2val (Op(op, Const(c1), Const(c2)))
                    

   method val2ht v = HTConst(v)          
          

   method exp2str env e = 
        match s#exp2val env e with
           Int(i) -> string_of_int i
        |  Bool(b) -> string_of_bool b
        |  Ch(c) -> c

   method expl2strl env el =
           match el with
              []  -> []
           |  x::y -> (s#exp2str env x)::(s#expl2strl env y)


   method  testheap io env ch = (*test per regola in rec e out*)
              if MyEnv.isindom ch env
                then let nch = MyEnv.valinenv ch env
                     in match nch with
                           HTConst(Ch(c)) -> 
                            ( let q = MyHeap.valinh c heap
                              in if MyQueue.isemptyq q
                                   then (true,c,q)
                                   else match (io, snd(MyQueue.qhd q)) with
                                          ("out",Out(_)) -> (true,c,q)
                                        | ("in",In(_))|("in",Inrec(_)) ->(true,c,q)
                                        | _ -> (false,c,q)
                            )

                        | _ -> raise (ChNotInNew (io^": no tipo HTCh associato a "^ch^" in env" ))
                else raise (ChNotInNew (io^": not in env "^ch ))




   method  testheapinpr env ch = (*test per regola inpr*)
                s#testheap "in" env ch

   method  testheapoutw env ch = (*test per regola outr*)
                s#testheap "out" env ch

    
   (* la comunicazione fallisce se il numero di argomenti e' diverso *)
   (* prima valutare le espressioni in out (el in eout) e poi associare in vl ein *)     
   method makeextenv eout vl el ein = 
           match (vl,el) with
              ([],[]) -> ein
           | (Var(v)::vl , e::el) -> let ne = MyEnv.addenv (v, s#val2ht (s#exp2val eout e) ) ein 
                                in s#makeextenv  eout vl el ne
           | _ ->  raise (IOFail "numero argomenti diversi: fallita comunicazione")





   method next =
      
      let (env,headrun) = MyQueue.qhd run   
      in match headrun with
            Zero ->
                MyQueue.takehdq run

         |  Par(p,q) -> 
                MyQueue.takehdq run;
                MyQueue.addhdq (env,p) run;
                MyQueue.addtlq (env,q) run

         |  New(v, p) -> 
                let v1 = v^s#cvarinc
                in let e1 = MyEnv.addenv (v, HTConst(Ch v1)) env
                   in    
                      MyHeap.addh v1 heap;
                      MyQueue.takehdq run;
                      MyQueue.addhdq (e1,p) run
               
         | Print(el, p) ->
                 let sl = s#expl2strl env el
                 in (s#flush sl;
                     MyQueue.takehdq run;
                     MyQueue.addhdq (env,p) run)

         | In(ch, vl, p) | Inrec(ch, vl, p) -> 
                         let (t,nch, nchq) = s#testheapinpr env ch (*h(ch) = rs?*)
                         in if t
                               then (MyQueue.addtlq  (env,headrun) nchq; 
                                     MyQueue.takehdq run)
                               else (* tolgo dalla coda H(ch)=q il proc Out
                                       e nell'ambiente associo... *)
                                    let (eout,pout) = MyQueue.qhd nchq
                                    in (MyQueue.takehdq nchq;
                                        match pout with
                                           Out(ch1, el, q) -> 
                                             ( let newenv = s#makeextenv eout vl  el env
                                               in match headrun with
                                                   In(_) ->
                                                      (
                                                       MyQueue.takehdq run;
                                                       MyQueue.addhdq (newenv, p) run;
                                                       MyQueue.addtlq (eout, q) run;
                                                      )
                                                  | Inrec(_) -> 
                                                      (
                                                       MyQueue.addtlq (newenv, p)  run;
                                                       MyQueue.addtlq (eout, q) run;
                                                      )
                                                  | _ -> raise  NP
                                              )
                                          | _ -> raise NP
                                         )

            | Out(ch, el, p) -> 
                         let (t,nch,nchq) = s#testheapoutw env ch (*h(ch) = ws?*)
                         in (if t
                               then (MyQueue.addtlq  (env,headrun) nchq; 
                                     MyQueue.takehdq run)
                               else (* tolgo dalla coda H(ch)=q il proc in o in rec... *)
                                    let (ein,pin) = MyQueue.qhd nchq
                                    in ( MyQueue.takehdq nchq;
                                         match pin with
                                           In(ch1, vl, q) | Inrec(ch1, vl, q) -> 
                                             ( let newenv = s#makeextenv env vl el ein
                                               in match pin with
                                                    In(_) ->
                                                       (
                                                        MyQueue.takehdq run;
                                                        MyQueue.addhdq (env, p) run;
                                                        MyQueue.addtlq (newenv, q) run;
                                                       )
                                                   | Inrec(_) -> 
                                                       (
                                                        MyQueue.takehdq run;
                                                        MyQueue.addtlq (ein,pin) nchq;
                                                        MyQueue.addhdq (env,p) run; 
                                                        MyQueue.addtlq (newenv, q)  run;
                                                       )
                                                  | _ -> raise NP  
                                             )
                                         | _ -> raise NP
                                       )  
                             )

         | Cond(c,p1,p2) -> MyQueue.takehdq run;
                            match s#exp2val env c with
                              Bool(true) -> MyQueue.addhdq (env,p1) run
                            | Bool(false) -> MyQueue.addhdq (env,p2) run
                            | _ -> raise  (IfCond "atteso valore bool")

        
    method nextn n = 
            if n>0 
               then (s#next ;
                    s#nextn (n-1))
               else ()
                         


    initializer MyQueue.addtlq (MyEnv.emptyenv, p) run

end
      


let test s n=
        print_string ("\n\n\n"^s^"\n");
        let sa = (new picparser(new picscanner(s)))#beginparse
        in let am = (new mk_state (sa))
           in am#nextn n; am ;;

let getAmObj str = 
	let sa = (new picparser(new picscanner(str)))#beginparse in 
	let am = (new mk_state (sa)) in am ;;

let s1 = "print![1+2, true, false]|print![true and false, 3]";;
 
test s1 3;;

let s4 = "new a in ( a?[].print![1]|a![].print![2] )";;

test s4 4;;

let s5 = "new a in new b in (a![b]|a?[x].x![true]|b?[x].print![x])";;

test s5 10;;
